home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
051-075
/
scopedisk59
/
sbasic
/
sb.asc
< prev
next >
Wrap
Text File
|
1995-03-19
|
22KB
|
664 lines
'
' SUPERBASIC V1.0
' AmigaBASIC OS Expansion Routines
' January 15, 1989
'
'
' © Copyright 1988, 1989 Robert Salesas
'
' 2354 Cote St. Catherine
' Montreal, Quebec
' H3T 1A9
'
' These routines are Public Domain. You may distribute them as you
' wish as long as this file is untouched in ANY way. Additions and
' modifications should be appended and sent to me at the above
' adress. I welcome comments and suggestions, either by mail
' on PLink or on Compuserve.
'
' PLINK: Robinette
' Compuserve: 76625,1320
'
'
Init:
DEFLNG A-Z
DIM SHARED CW, RP, Scrn, Response
DIM SHARED AddKey(11,10), SizeKey(11,10), RememberKey
DIM SHARED CHIP, FAST, PUBLIC, NULL, NULL%, NilFh
DIM SHARED Structure$, StructFlags
DIM SHARED BYTE, DBYTE, DWORD, WORD, LONG, APTR
DIM SHARED GCNT, GadgetInfo(10,4)
CHIP=2:FAST=4:PUBLIC=0:NULL=0:NULL%=0:RememberKey=11
BYTE=1:DBYTE=2:DWORD=3:WORD=16:LONG=17:APTR=17
GCNT=10 ' Maximum amount of gadgets you will be using at one time
LIBRARY "LIBS:exec.library"
LIBRARY "LIBS:graphics.library"
LIBRARY "LIBS:dos.library"
LIBRARY "LIBS:diskfont.library"
LIBRARY "LIBS:intuition.library"
DECLARE FUNCTION xOpen() LIBRARY
DECLARE FUNCTION xRead() LIBRARY
DECLARE FUNCTION xWrite() LIBRARY
DECLARE FUNCTION CreateDir() LIBRARY
DECLARE FUNCTION SetProtection() LIBRARY
DECLARE FUNCTION xInput() LIBRARY
DECLARE FUNCTION xOutput() LIBRARY
DECLARE FUNCTION Execute() LIBRARY
DECLARE FUNCTION IoErr() LIBRARY
DECLARE FUNCTION Examine() LIBRARY
DECLARE FUNCTION ExNext() LIBRARY
DECLARE FUNCTION Lock() LIBRARY
DECLARE FUNCTION SetComment() LIBRARY
DECLARE FUNCTION OpenFont() LIBRARY
DECLARE FUNCTION OpenDiskFont() LIBRARY
DECLARE FUNCTION DisplayAlert() LIBRARY
DECLARE FUNCTION AllocMem() LIBRARY
DECLARE FUNCTION AvailMem() LIBRARY
DECLARE FUNCTION AutoRequest() LIBRARY
DECLARE FUNCTION WindowLimits() LIBRARY
DECLARE FUNCTION OpenWorkBench() LIBRARY
DECLARE FUNCTION CloseWorkBench() LIBRARY
DECLARE FUNCTION WBenchToBack() LIBRARY
DECLARE FUNCTION WBenchToFront() LIBRARY
SubStart:
SUB PROPGADGET (Wind%,Num%,Le%,Top%,Wi%,He%,Border%,Mov%,Hp%,Vp%,Hb%,Vb%) STATIC
' Mov% 1=Hor, 2=Ver
WINFO Wind%:Flags=1:TI=0
IF Border%=0 THEN Flags=9
IF Mov%=1 THEN Flags=Flags+2
IF Mov%=2 THEN Flags=Flags+4
IF Mov%=3 THEN Flags=Flags+6
GadgetInfo(Num%,0)=AllocMem(48,CHIP+65537&) 'Gadget Structure
GadgetInfo(Num%,1)=AllocMem(48,CHIP+65537&) 'String Info
STRUCT GadgetInfo(Num%,0)
STR APTR,NULL 'Next Gadget
STR WORD,CLNG(Le%):STR WORD,CLNG(Top%) 'Left & Top
STR WORD,CLNG(Wi%):STR WORD,CLNG(He%) 'Width & Height
STR WORD,1&:STR WORD,3&:STR WORD,3& 'Flags & Activation Flags, Type
STR APTR,NULL:STR APTR,NULL:STR APTR,NULL:STR LONG,NULL 'Gadget Stuff
STR LONG,GadgetInfo(Num%,1) 'Prop Info Structure
STR WORD,CLNG(Num%):STR LONG,NULL 'Our Gadget Number & UserData
ENDSTRUCT GadgetInfo(Num%,0),NULL,NULL
STRUCT GadgetInfo(Num%,1)
STR WORD,Flags:STR WORD,CLNG(Hp):STR WORD,CLNG(Vp)
STR WORD,CLNG(Hb):STR WORD,CLNG(Vb)
STR WORD,NULL:STR WORD,NULL:STR WORD,NULL
STR WORD,NULL:STR WORD,NULL
ENDSTRUCT GadgetInfo(Num%,1),NULL,NULL
ADDGADGET CW,GadgetInfo(Num%,0),-1
END SUB
SUB GADGET (Wind%,Num%,Le%,Top%,Wi%,He%,Type%,High%,SPos%,VChar%,MChar%,IVal$) STATIC
' Type 1=Boolean, 2=Toggle Boolean, 3=String Left, 4= Integer Left
' High 0=Complement, 1=Box, 3=None
' SPos 1=String Right, 2=String Center
WINFO Wind%:Flags=0:AFlags=0:TI=0
GadgetInfo(Num%,0)=AllocMem(48,CHIP+65537&) 'Gadget Structure
IF Type%>2 THEN
GadgetInfo(Num%,1)=AllocMem(64,CHIP+65537&) 'String Info
GadgetInfo(Num%,2)=AllocMem(MChar%+1,CHIP+65537&) 'Buffer
FOR Loop=1 TO LEN(IVal$)
GadgetInfo(Num%,2)=ASC(MID$(IVal$,Loop,1))
NEXT Loop
GadgetInfo(Num%,2,)=GadgetInfo(Num%,2,)+CHR$(NULL)
GadgetInfo(Num%,3)=MChar%
IF SPos%=1 THEN
AFlags=1024
ELSEIF SPos%=2 THEN
AFlags=512
END IF
IF Type%=4 THEN AFlags=AFlags+2048:TI=1
Type%=4
END IF
Flags=Flags+High%
IF Type%=2 THEN Type%=1:AFlags=AFlags+256
STRUCT GadgetInfo(Num%,0)
STR APTR,NULL 'Next Gadget
STR WORD,CLNG(Le%):STR WORD,CLNG(Top%) 'Left & Top
STR WORD,CLNG(Wi%):STR WORD,CLNG(He%) 'Width & Height
STR WORD,Flags:STR WORD,AFlags+3:STR WORD,CLNG(Type%) 'Flags & Activation Flags, Type
STR APTR,NULL:STR APTR,NULL:STR APTR,NULL:STR LONG,NULL 'Gadget Stuff
STR LONG,GadgetInfo(Num%,1) 'String Info Structure
STR WORD,CLNG(Num%):STR LONG,NULL 'Our Gadget Number & UserData
ENDSTRUCT GadgetInfo(Num%,0),NULL,NULL
IF Type%=4 THEN
STRUCT GadgetInfo(Num%,1)
STR APTR,GadgetInfo(Num%,2):STR APTR,NULL 'Buffer & Undo Buffer
STR WORD,NULL:STR WORD,1&+MChar%:STR WORD,NULL 'Character information
STR WORD,NULL:STR WORD,LEN(IVal$):STR WORD,CLNG(VChar%)
STR WORD,NULL:STR WORD,NULL:STR LONG,NULL:STR LONG,NULL
STR APTR,NULL
ENDSTRUCT GadgetInfo(Num%,1),NULL,NULL
END IF
ADDGADGET CW,GadgetInfo(Num%,0),-1
END SUB
SUB ULTRASORT (Array$(1),LArray%,UArray%) STATIC
FOR Loop=LArray%+1 TO UArray%
APos=Loop:DT$=Array$(APos):Again=1
WHILE Again
IF APos=LArray% THEN
Array$(APos)=DT$:Again=0
ELSEIF Array$(APos-1)<=DT$ THEN
Array$(APos)=DT$:Again=0
ELSE
Array$(APos)=Array$(APos-1):APos=APos-1
END IF
WEND
NEXT Loop
END SUB
SUB BUBBLESORT (Array$(1),LArray%,UArray%) STATIC
FOR L1=LArray% TO UArray%
FOR L2=L1+1 TO UArray%
IF Array$(L2) < Array$(L1) AND Array$(L1) = "" THEN
SWAP Array$(L2),Array$(L1)
END IF
NEXT L2
NEXT L1
END SUB
SUB COPYARRAY (AFrom$(1),ATo$(1)) STATIC
IF LBOUND(AFrom$)<>LBOUND(ATo$) OR UBOUND(ATo$)<UBOUND(AFrom$) THEN ERROR 9
FOR Loop=LBOUND(AFrom$) TO UBOUND(AFrom$)
ATo$(Loop)=AFrom$(Loop)
NEXT Loop
END SUB
SUB SUBSTRING (VStr$,SStr$,SFrom%,STo%) STATIC
SStr$=MID$(VStr$,SFrom%,STo%-SFrom%)
END SUB
SUB FROMCLI (Inp,Out) STATIC
' If Inp, Out=0 then program was started from WorkBench
' else returns Filehandler to a console window (not necc. CLI)
Inp=xInput(0):Out=xOutput(0)
END SUB
SUB EXEC (Command$,Parameters$,Mode%) STATIC
' Mode 1 = Run, 0 = Execute Normally
IF NOT Called THEN
NilFh=xOpen(SADD("NIL:"+CHR$(NULL)),1005)
IF NilFh=NULL THEN ERROR 57
Called=1
END IF
IF Mode%=1 THEN
Command$="RUN >NIL: <NIL: "+Command$+" >NIL: <NIL: "+Parameters$+CHR$(NULL)
ELSE
Command$=Command$+" >NIL: <NIL: "+Parameters$+CHR$(NULL)
END IF
Io=Execute(SADD(Command$),NilFh,NilFh)
IF Io=NULL THEN ERROR 57
END SUB
SUB DIR (DirName$,Buff$(1),FBytes(1)) STATIC
' Type FBytes -1 = Directory, 0 >= File
MFiles=UBOUND(Buff$)
FLock=Lock(SADD(DirName$+CHR$(NULL)),-2):IF FLock=NULL THEN ERROR 57
ALLOCMEMORY 256&,CHIP,Fib,RememberKey
Io=Examine(FLock,Fib):IF Io=NULL THEN ERROR 57
File=-1:GOSUB GetFileName
IF PEEKL(Fib+4)<1 THEN
FREEMEMORY RememberKey
UNLOCK FLock
EXIT SUB
END IF
WHILE Io<>NULL AND File<>MFiles
GOSUB GetFileName
WEND
FREEMEMORY RememberKey
UNLOCK FLock
EXIT SUB
GetFileName:
File=File+1:Offset=8:FChar=PEEK(Fib+Offset)
WHILE FChar<>NULL
Buff$(File)=Buff$(File)+CHR$(FChar)
Offset=Offset+1:FChar=PEEK(Fib+Offset)
WEND
IF PEEKL(Fib+4)>0 THEN FBytes(File)=-1 ELSE FBytes(File)=PEEKL(Fib+124)
Io=ExNext(FLock,Fib)
RETURN
END SUB
SUB FILECOMMENT (FileName$,Comment$) STATIC
Io=SetComment(SADD(FileName$+CHR$(NULL)),SADD(Comment$+CHR$(NULL)))
IF Io=NULL THEN ERROR 57
END SUB
SUB PROTECT (FileName$,Flag%) STATIC
' Flag 0 = RWED, 1 = RWE-, 2 = RW-D, 4 = R-ED, 8 = -WED
Io=SetProtection(SADD(FileName$+CHR$(NULL)),Flag%)
IF Io=NULL THEN ERROR 57
END SUB
SUB COPY (FromFile$,ToFile$) STATIC
OPEN FromFile$ FOR INPUT AS 255:Size=LOF(255):CLOSE 255:Badd=0:Buff=Size:TSize=0
Fh1=xOpen(SADD(FromFile$+CHR$(NULL)),1005):IF Fh1=NULL THEN ERROR 57
Fh2=xOpen(SADD(ToFile$+CHR$(NULL)),1006):IF Fh2=NULL THEN ERROR 57
WHILE Badd=0
ALLOCMEMORY Buff,FAST,Badd,RememberKey
IF Badd=0 THEN Buff=Buff-512:IF Buff<512 THEN ERROR 7
WEND
WHILE TSize<>Size
RSize=xRead(Fh1,Badd,Buff):IF RSize=NULL THEN ERROR 57
WSize=xWrite(Fh2,Badd,RSize):IF WSize=NULL THEN ERROR 57
TSize=TSize+RSize
WEND
FREEMEMORY RememberKey
xCLOSE Fh1:xCLOSE Fh2
END SUB
SUB MAKEDIR (FileName$) STATIC
Io=CreateDir(SADD(FileName$+CHR$(NULL)))
IF Io=NULL THEN ERROR 57
END SUB
SUB BLOAD (FileName$,Badd,Type,Key) STATIC
OPEN FileName$ FOR INPUT AS 255:Size=LOF(255):CLOSE 255
ALLOCMEMORY Size,Type,Badd,Key:IF Badd=NULL THEN ERROR 7
Fh=xOpen(SADD(FileName$+CHR$(NULL)),1005):IF Fh=NULL THEN ERROR 57
Io=xRead(Fh,Badd,Size):IF Io=NULL THEN ERROR 57
FREEMEMORY Key
xCLOSE Fh
END SUB
SUB BSAVE (FileName$,Badd,Size) STATIC
Fh=xOpen(SADD(FileName$+CHR$(NULL)),1006):IF Fh=NULL THEN ERROR 57
Io=xWrite(Fh,Badd,Size):IF Io=NULL THEN ERROR 57
xCLOSE Fh
END SUB
SUB CLIP (Wind%,Px%,Py%,Wind2%,Px2%,Py2%,Sx%,Sy%) STATIC
OldW=WINDOW (1)
WINDOW OUTPUT (Wind%):RP1=WINDOW (8)
WINDOW OUTPUT (Wind2%):RP2=WINDOW (8)
CLIPBLIT RP1,Px%,Py%,RP2,Px2%,Py2%,Sx%,Sy%,192
WINDOW OUTPUT (OldW)
END SUB
SUB BORDER (Badd,LOffset%,TOffset%) STATIC
' Badd = Pointer to a Border Structure
WINFO 0
DRAWBORDER RP,Badd,LOffset%,TOffset%
END SUB
SUB MATDRAW (Pts(1),Col%,Mode%) STATIC
WINFO 0
SETDRMD RP,Mode%
COLOR Col%,0
POLYDRAW RP,VARPTR(Pts),Padd+2
SETDRMD RP,1
END SUB
SUB FLOODFILL (Px%,Py%,Col%) STATIC
WINFO 0
POKE RP+27,Col%:POKEW RP+32,PEEKW(RP+32) OR 8
FLOOD RP,NULL,Px%,Py%
END SUB
SUB SETOPEN (Col%) STATIC
WINFO 0
POKE RP+27,Col%:POKEW RP+32,PEEKW(RP+32) OR 8
END SUB
SUB POINTEROFF (Wind%) STATIC
WINFO Wind%
CLEARPOINTER CW
END SUB
SUB POINTERON (Wind%,Padd) STATIC
WINFO Wind%
XOffset=PEEKW(Padd+76):YOffset=PEEKW(Padd+78)
SETPOINTER CW,Padd,16,16,XOffset,YOffset
END SUB
SUB SYSREQUESTER (Wind%,Rx%,Ry%,TLines%,Col%,PText$(1),Flags%) STATIC
' Flags 1=Normal, 2=Disk Inserted, 3=Disk Removed, 4=Both
IF Wind%>0 THEN
WINFO Wind%
ELSE
CW=NULL
END IF
TLines%=TLines%+1:NextText=0
FOR Loop=TLines% TO 0 STEP -1
PText$(Loop)=PText$(Loop)+CHR$(NULL)
STRUCT IText(Loop) 'IntuiText Structure
STR BYTE,CLNG(Col%):STR BYTE,1&:STR BYTE,1& 'FPen, BPen, Drawmode
STR WORD,6&:STR WORD,3&+(8*Loop)*ABS(Loop<TLines%-1) 'Top
STR APTR,NULL 'Fontdef
STR APTR,SADD(PText$(Loop)):STR APTR,NextText 'Text & Next Text
ENDSTRUCT IText(Loop),CHIP,RememberKey
NextText=IText(Loop)*ABS(Loop<TLines%-1) 'Determine Next Text
NEXT Loop
PText=IText(TLines%-1):NText=IText(TLines%)
IDCMP=(32768&*ABS(Flags%=2))+(65536&*ABS(Flags%=3))+(98304&*ABS(Flags%=4))
IF PText$(TLines%-1)=CHR$(NULL) THEN PText=NULL:IDCMP=NULL
Response=AutoRequest(CW,IText(0),PText,NText,IDCMP,NULL,Rx%,Ry%)
FREEMEMORY RememberKey
END SUB
SUB ALERT (Text1$,Text2$,TLeft$,TRight$) STATIC
Px=320-LEN(Text1$)*4:Px2=320-LEN(Text2$)*4:Sp=31-(LEN(TLeft$)+LEN(TRight$))
Text3$="Left Mouse Button To "+TLeft$+SPACE$(Sp)+"Right Mouse Button To "+TRight$
STRUCT AlertText
STR DBYTE,Px:STR BYTE,15&:NSTR Text1$:STR BYTE,1&
STR DBYTE,Px2:STR BYTE,25&:NSTR Text2$:STR BYTE,1&
STR DBYTE,24&:STR BYTE,41&:NSTR Text3$:STR BYTE,0&
ENDSTRUCT AlertText,CHIP,RememberKey
Response=DisplayAlert(NULL,AlertText,53&)
FREEMEMORY RememberKey
END SUB
SUB DRAWMODE (Mode%) STATIC
WINFO 0
SETDRMD RP,Mode%
END SUB
SUB PRINTAT (Px%,Py%,SText$) STATIC
WINFO 0
MOVE RP,Px%,Py%
TEXT RP,SADD(SText$),LEN(SText$)
END SUB
SUB SHADOW (TCol%,ShCol%,Px%,Py%,SText$) STATIC
WINFO 0
SETDRMD RP,1:COLOR ShCol%
MOVE RP,Px%+1,Py%+1:TEXT RP,SADD(SText$),LEN(SText$)
SETDRMD RP,0:COLOR TCol%
MOVE RP,Px%,Py%:TEXT RP,SADD(SText$),LEN(SText$)
SETDRMD RP,1
END SUB
SUB STYLESET (Style%) STATIC
' 0=Norm. 1=Under. 2=Bold 3=Italic
WINFO 0
SETSOFTSTYLE RP,Style%,255
END SUB
SUB FONTOPEN (Font$,Sz%,FontDef) STATIC
Attribute(0)=SADD(Font$+".font"+CHR$(0))
Attribute(1)=65536&*Sz%
FontDef=OpenFont(VARPTR(Attribute(0)))
IF FontDef=NULL THEN FontDef=OpenDiskFont(VARPTR(Attribute(0)))
IF FontDef=NULL THEN ERROR 53
END SUB
SUB FONTSET (FontDef) STATIC
WINFO 0
SETFONT RP,FontDef
END SUB
SUB FONTCLOSE (FontDef) STATIC
CLOSEFONT FontDef
REMFONT FontDef
END SUB
SUB GETLINE (SText$,Length%,Row%,Col%,Clrs%,Box%,BClrs%) STATIC
IF Box%>0 THEN
Px%=Col%*8-11:Py%=Row%*8-10:LP%=Length%*8+13
LINE (Px%,Py%)-STEP(LP%,10),0,BF
LINE (Px%,Py%)-STEP(LP%,10),BClrs%,b
END IF
SText$=""
LOCATE Row%,Col%
WHILE Key%<>13
Key$="":Key%=0
WHILE Key$=""
COLOR 0,2:PRINT CHR$(32);CHR$(8);:COLOR Clrs%,0
SLEEP
Key$=INKEY$
WEND
Key%=ASC(Key$)
IF Key%>31 THEN
IF LEN(SText$)<Length% THEN
SText$=SText$+CHR$(Key%)
PRINT CHR$(Key%);
ELSE
BEEP
END IF
ELSE
IF Key%=8 AND LEN(SText$)=1 THEN
SText$=""
PRINT CHR$(32);CHR$(8);CHR$(8);
ELSEIF Key%=8 AND LEN(SText$)>1 THEN
SText$=LEFT$(SText$,LEN(SText$)-1)
PRINT CHR$(32);CHR$(8);CHR$(8);
END IF
IF Key%=27 THEN
LOCATE Row%,Col%
PRINT SPACE$(LEN(SText$)+1);
LOCATE Row%,Col%
SText$=""
END IF
END IF
WEND
PRINT CHR$(32);CHR$(8);
END SUB
SUB CLEARMENU (Wind%) STATIC
WINFO Wind%
CLEARMENUSTRIP CW
END SUB
SUB MENUOFF STATIC
FOR Loop=1 TO 10
MENU Loop,0,0,""
NEXT Loop
END SUB
SUB CHECKMENU (MenuNum%,Item%,State%) STATIC
WINFO 0:MENUPOS MenuNum%,Item%,Head,Command,Flags
FlagSet=PEEKW(Flags):State%=0
IF (FlagSet OR 256) = FlagSet THEN State%=1
END SUB
SUB SUPERMENU (MenuNum%,Item%,State%,High%,MenuText$,KeyComm$) STATIC
WINFO 0
IF KeyComm$="" THEN Comm=0:FlagSet=0 ELSE Comm=ASC(MID$(KeyComm$,1,1)):FlagSet=4
IF State%=2 THEN
FlagSet=8
ELSEIF State%=3 THEN
State%=1:FlagSet=9
END IF
IF High%=0 THEN FlagSet=FlagSet+192 ELSE FlagSet=FlagSet+64
MENU MenuNum%,Item%,State%,MenuText$:IF Item%=0 THEN EXIT SUB
T!=TIMER:WHILE T!+.1>TIMER:WEND
MENUPOS MenuNum%,Item%,Head,Command,Flags
POKE Command,Comm:POKEW Flags,PEEKW(Flags) OR FlagSet
CLEARMENUSTRIP CW:SETMENUSTRIP CW,Head
END SUB
SUB MENUPOS (MenuNum%,Item%,Head,Command,Flags) STATIC
MenuData:
Head=PEEKL(CW+28):Menu1=Head
IF MenuNum%>1 THEN
FOR Loop=1 TO MenuNum%-1
Menu1=PEEKL(Menu1)
NEXT Loop
END IF
MenuItem=PEEKL(Menu1+18):temp=MenuItem
IF Item%>1 THEN
FOR Loop=1 TO Item%-1
MenuItem=PEEKL(MenuItem)
NEXT Loop
END IF
IF MenuItem<0 OR MenuItem>9216000& THEN MenuData
Command=MenuItem+26:Flags=MenuItem+12
END SUB
SUB SETTITLE (Wind%,WTitle$,STitle$) STATIC
' WTitle = Window title, STitle = Screen Title
' "" = No title, "=" = No change
WINFO Wind%
WTadd=SADD(WTitle$+CHR$(NULL))
STadd=SADD(STitle$+CHR$(NULL))
IF WTitle$="" THEN WTadd=0
IF WTitle$="=" THEN WTadd=-1
IF STitle$="" THEN STadd=0
IF STitle$="=" THEN STadd=-1
SETWINDOWTITLES CW,WTadd,STadd
END SUB
SUB WINFO (Wind%) STATIC
IF Wind%>0 THEN
OldW=WINDOW (1)
WINDOW OUTPUT (Wind%)
END IF
CW=WINDOW(7):RP=WINDOW(8):Scrn=PEEKL(CW+46)
IF Wind%>0 THEN WINDOW OUTPUT (OldW)
END SUB
SUB REFRESHFRAME (Wind%) STATIC
WINFO Wind%
REFRESHWINDOWFRAME CW
END SUB
SUB WINDOWACT (Wind%) STATIC
WINFO Wind%
WINDOW Wind%
ACTIVATEWINDOW CW
END SUB
SUB WINDOWTO (Wind%,Mode%) STATIC
' Mode 1 = Front, -1 = Back
WINFO Wind%
IF Mode%=-1 THEN
WINDOWTOBACK CW
ELSEIF Mode%=1 THEN
WINDOWTOFRONT CW
END IF
END SUB
SUB WINDOWMOVE (Wind%,Px%,Py%) STATIC
' Moves from current position + Px,Py
WINFO Wind%
MOVEWINDOW CW,Px%,Py%
END SUB
SUB WINDOWSIZE (Wind%,Px%,Py%) STATIC
' Sizes from current size + Px,Py
WINFO Wind%
SIZEWINDOW CW,Px%,Py%
END SUB
SUB SETWINDOWLIMITS (Wind%,Minx%,Miny%,Maxx%,Maxy%) STATIC
' Absolute values
WINFO Wind%
Response=WindowLimits(CW,Minx%,Miny%,Maxx%,Maxy%)
END SUB
SUB WORKBENCH (Mode%) STATIC
' Mode = 1 Open WorkBench, -1 Close WorkBench
IF Mode%=1 THEN
Response=OpenWorkBench(0)
ELSEIF Mode%=-1 THEN
Response=CloseWorkBench(0)
END IF
END SUB
SUB WORKBENCHTO (Mode%) STATIC
' Mode = 1 WorkBench to front, -1 WorkBench to back
IF Mode%=1 THEN
Response=WBenchToFront(0)
ELSEIF Mode%=-1 THEN
Response=WBenchToBack(0)
END IF
END SUB
SUB SCREENTO (Wind%,Mode%) STATIC
' Wind = Window attached to Screen, Mode = 1 Screen to front, -1 Screen to back
WINFO Wind%
IF Mode%=1 THEN
SCREENTOFRONT Scrn
ELSEIF Mode%=-1 THEN
SCREENTOBACK Scrn
END IF
END SUB
SUB SCREENMOVE (Wind%,Px%,Py%) STATIC
' Wind = Window attached to Screen, Moves from current position + Px,Py
WINFO Wind%
MOVESCREEN Scrn,Px%,Py%
END SUB
SUB MOUSECLICK STATIC
WHILE MOUSE(0)<>NULL:WEND
WHILE MOUSE(0)=NULL:SLEEP:WEND
END SUB
SUB STRUCT (StrAdd) STATIC
StructFlags=NULL:Structure$=""
END SUB
SUB STR (Mode, Value) STATIC
' Byte=1, DByte=2, DWord=3, Word=16, Long=17, Aptr=17
' Value holds amount to insert in structure
IF Mode>15 AND StructFlags=1 THEN Structure$=Structure$+CHR$(NULL):StructFlags=NULL
IF Mode=1 THEN ' Byte
StructFlags=StructFlags XOR 1
Structure$=Structure$+CHR$(Value)
ELSEIF Mode=2 OR Mode=16 THEN ' DByte Word
Structure$=Structure$+MKI$(Value)
ELSEIF Mode=3 OR Mode=17 THEN ' DWord, Long, Pointer
Structure$=Structure$+MKL$(Value)
END IF
END SUB
SUB NSTR (Value$) STATIC
Structure$=Structure$+Value$+CHR$(NULL)
END SUB
SUB ENDSTRUCT (StrAdd,Type,Key) STATIC
' Type is either CHIP(2) or FAST(4)
' StructKey contains Key with which to free memory
Size=LEN(Structure$)
IF StrAdd=0 THEN
ALLOCMEMORY Size,Type,StrAdd,Key
IF StrAdd=NULL THEN ERROR 7
END IF
FOR Loop=1 TO Size
POKE StrAdd+Loop-1,ASC(MID$(Structure$,Loop,1))
NEXT Loop
Structure$=""
END SUB
SUB MEMORY (Type,Amount) STATIC
Amount=AvailMem(Type+65537&)
END SUB
SUB ALLOCMEMORY (Size,Type,Add,Key) STATIC
Add=AllocMem(Size,65537&+Type):IF Add=0 THEN EXIT SUB
Loop=LBOUND(AddKey,2)
WHILE AddKey(Key,Loop)<>Add
IF AddKey(Key,Loop)=NULL THEN
AddKey(Key,Loop)=Add:SizeKey(Key,Loop)=Size:Loop=Loop-1
END IF
Loop=Loop+1
WEND
END SUB
SUB FREEMEMORY (Key) STATIC
FOR Loop=LBOUND(AddKey,2) TO UBOUND(AddKey,2)
IF AddKey(Key,Loop)>NULL THEN
FREEMEM AddKey(Key,Loop),SizeKey(Key,Loop)
AddKey(Key,Loop)=NULL:SizeKey(Key,Loop)=NULL
END IF
NEXT Loop
END SUB